hogwarts <- read_csv("data/hogwarts_2024.csv")
hogwarts |> head()
## # A tibble: 6 × 60
## id house course sex wandCore bloodStatus result Defence against the …¹
## <dbl> <chr> <dbl> <chr> <chr> <chr> <dbl> <dbl>
## 1 1 Ravencl… 4 fema… unicorn… half-blood 94 73
## 2 2 Hufflep… 5 male phoenix… half-blood 33 38
## 3 3 Ravencl… 4 fema… dragon … half-blood 137 52
## 4 4 Hufflep… 2 male phoenix… half-blood 27 50
## 5 5 Hufflep… 2 fema… phoenix… half-blood 67 47
## 6 6 Gryffin… 6 male phoenix… muggle-born 126 44
## # ℹ abbreviated name: ¹`Defence against the dark arts exam`
## # ℹ 52 more variables: `Flying exam` <dbl>, `Astronomy exam` <dbl>,
## # `Herbology exam` <dbl>, `Divinations exam` <dbl>, `Charms exam` <dbl>,
## # `History of magic exam` <dbl>, `Arithmancy exam` <dbl>,
## # `Care of magical creatures exam` <dbl>, `Muggle studies exam` <dbl>,
## # `Study of ancient runes exam` <dbl>, `Transfiguration exam` <dbl>,
## # `Potions exam` <dbl>, week_1 <dbl>, week_2 <dbl>, week_3 <dbl>, …
hogwarts |> glimpse()
## Rows: 560
## Columns: 60
## $ id <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11…
## $ house <chr> "Ravenclaw", "Hufflepuff", "Raven…
## $ course <dbl> 4, 5, 4, 2, 2, 6, 7, 5, 2, 3, 7, …
## $ sex <chr> "female", "male", "female", "male…
## $ wandCore <chr> "unicorn hair", "phoenix feather"…
## $ bloodStatus <chr> "half-blood", "half-blood", "half…
## $ result <dbl> 94, 33, 137, 27, 67, 126, 63, 7, …
## $ `Defence against the dark arts exam` <dbl> 73, 38, 52, 50, 47, 44, 51, 47, 2…
## $ `Flying exam` <dbl> 33, 36, 73, 42, 41, 52, 34, 34, 2…
## $ `Astronomy exam` <dbl> 57, 45, 66, 49, 57, 59, 58, 37, 5…
## $ `Herbology exam` <dbl> 73, 50, 62, 39, 38, 46, 59, 23, 2…
## $ `Divinations exam` <dbl> 66, 54, 72, 42, 47, 49, 42, 38, 1…
## $ `Charms exam` <dbl> 60, 70, 77, 46, 35, 55, 86, 20, 4…
## $ `History of magic exam` <dbl> 52, 36, 60, 45, 50, 40, 55, 21, 2…
## $ `Arithmancy exam` <dbl> 61, 36, 58, 32, 76, 50, 41, 31, 2…
## $ `Care of magical creatures exam` <dbl> 44, 41, 70, 36, 46, 73, 29, 36, 4…
## $ `Muggle studies exam` <dbl> 64, 34, 52, 59, 50, 54, 36, 31, 4…
## $ `Study of ancient runes exam` <dbl> 50, 35, 59, 39, 48, 56, 47, 41, 3…
## $ `Transfiguration exam` <dbl> 74, 70, 70, 15, 32, 86, 100, 31, …
## $ `Potions exam` <dbl> 67, 38, 22, 64, 56, 60, 62, 55, 1…
## $ week_1 <dbl> 0, -5, 0, -1, 1, 5, 1, -20, 3, -2…
## $ week_2 <dbl> -10, 1, 0, 5, 20, 10, -5, 10, 1, …
## $ week_3 <dbl> 0, -1, 1, -5, 10, -5, 3, -5, -3, …
## $ week_4 <dbl> 10, 1, -1, 10, -10, 10, 0, -10, -…
## $ week_5 <dbl> 3, -5, 3, 0, -1, 20, 5, 5, -3, 5,…
## $ week_6 <dbl> -20, 20, 0, 0, 0, 0, 0, 5, 0, -1,…
## $ week_7 <dbl> 10, 10, 1, -3, -20, 1, 10, 3, -5,…
## $ week_8 <dbl> 5, 5, 1, -5, 5, 5, 0, 1, 0, 20, -…
## $ week_9 <dbl> 1, 1, 3, -1, 0, 3, -20, -20, -10,…
## $ week_10 <dbl> 20, -10, 1, 5, -1, 0, 5, -5, 5, 3…
## $ week_11 <dbl> 5, -10, 20, 0, 0, 0, 5, 10, 5, 5,…
## $ week_12 <dbl> 5, -5, 1, -20, -10, -5, 0, 5, 1, …
## $ week_13 <dbl> -20, -5, 10, 0, 0, 1, -1, 10, -20…
## $ week_14 <dbl> 0, 5, 3, 10, -10, 20, 0, -20, -20…
## $ week_15 <dbl> 1, 20, 1, 0, -20, 10, 1, 3, -20, …
## $ week_16 <dbl> 20, 5, 5, 5, 0, 3, 10, -1, 5, 5, …
## $ week_17 <dbl> 3, 0, 10, 5, 5, -5, -1, 10, -10, …
## $ week_18 <dbl> 10, 5, 5, 5, 10, -20, 0, 10, 3, 5…
## $ week_19 <dbl> -10, 0, -5, -1, 0, -1, 0, 20, 0, …
## $ week_20 <dbl> 10, -10, 5, 10, 0, -1, -1, 10, 0,…
## $ week_21 <dbl> 0, 5, 5, 3, 5, 0, 0, -5, -5, 5, 5…
## $ week_22 <dbl> 20, -5, 5, 0, 20, 5, -1, 0, 0, 20…
## $ week_23 <dbl> 5, 1, -3, 20, -5, 20, 0, 1, 1, 5,…
## $ week_24 <dbl> 10, -20, -20, 0, 10, 5, 5, -3, -5…
## $ week_25 <dbl> 0, -20, 1, 3, 5, 1, -5, 0, -20, 2…
## $ week_26 <dbl> 10, 10, 5, -1, 0, 5, 5, -3, 0, 20…
## $ week_27 <dbl> 5, 5, -3, 0, 20, 5, 0, -5, 10, 3,…
## $ week_28 <dbl> -3, 20, 20, 1, 10, 5, 1, 10, 0, 1…
## $ week_29 <dbl> -20, -5, 5, 5, -10, 1, 0, -3, 0, …
## $ week_30 <dbl> 5, 1, -5, 5, -5, -1, -20, 20, 1, …
## $ week_31 <dbl> 5, 5, 20, -5, -10, -3, 0, -10, 20…
## $ week_32 <dbl> -5, 1, 20, -1, -10, 5, 10, 1, 0, …
## $ week_33 <dbl> 0, 10, 3, 3, 0, 0, -1, 0, -20, 3,…
## $ week_34 <dbl> 0, -1, 0, 0, 10, 3, 20, -5, 10, 3…
## $ week_35 <dbl> 5, -5, 3, -10, 3, -5, 0, 0, 0, 0,…
## $ week_36 <dbl> 1, 5, 1, -20, 5, 20, -1, -3, 1, 3…
## $ week_37 <dbl> 0, 0, 10, -1, 10, 3, 3, 0, 20, 1,…
## $ week_38 <dbl> 10, -1, 0, -5, 5, 5, 20, -5, -3, …
## $ week_39 <dbl> 3, 5, 1, 10, 20, 0, 5, 1, -5, 0, …
## $ week_40 <dbl> 0, 0, 5, 1, 5, 1, 10, -5, -20, 3,…
# Changing some variables type to factors
hogwarts <- hogwarts |> mutate(
across(c(house, course, sex, wandCore, bloodStatus), ~ as.factor(.x))
)
ggplot(hogwarts)+
geom_bar(aes(x = course,
fill = course),
colour = "black")+
scale_fill_manual(values = c("1" = "red", "2" = "orange", "3" = "yellow", "4" = "green", "5" = "turquoise2", "6" = "blue", "7" = "violet"))+
theme_classic()
theme_custom <- theme(
axis.title.x = element_text(size = 22),
axis.title.y = element_text(size = 22),
axis.text.x = element_text(size = 18),
axis.text.y = element_text(size = 18),
legend.title = element_text(size = 22),
legend.text = element_text(size = 18),
plot.title = element_text(size = 26),
panel.background = element_rect(fill='white'),
panel.grid.major = element_line(color = 'gray60', size = 0.5),
panel.grid.minor = element_line(color = 'gray80', size = 0.25),
)
ggplot(hogwarts)+
geom_bar(aes(x = course,
fill = bloodStatus),
position = "fill",
colour = "black")+
scale_fill_manual(values = c("half-blood" = "pink", "muggle-born" = "yellow", "pure-blood" = "turquoise2"))+
theme_classic()+
theme_custom
Из графика можно сделать вывод, что большинство обучающихся на каждом из
курсов Хогвартса - полукровки, а меньшинство - маглорожденные. Есть
динамика изменения пропорций, но нет определенного тренда на увеличение
или уменьшение доли одной из групп волшебников среди новых наборов.
hogwarts |>
filter( bloodStatus != "half-blood") |>
ggplot()+
geom_bar(aes(x = course,
fill = bloodStatus),
position = "fill",
colour = "black")+
scale_fill_manual(values = c("muggle-born" = "yellow", "pure-blood" = "turquoise2"),
labels = c("muggle-born" = "Маглорожденные", "pure-blood" = "Чистокровные"))+
geom_hline(yintercept = 0.50, linetype = "dashed", color = "red") +
labs(x = "Курс", y = "Доля студентов", fill = "Происхождение") +
theme_custom
hogwarts |>
select(house, week_3)|>
ggplot()+
geom_boxplot(aes(x = fct_reorder(house, week_3, .desc = TRUE), y = week_3))+
labs(x = "Факультет", y = "Оценка за третью неделю") +
theme_custom
hogwarts |>
select(house, week_3, bloodStatus)|>
ggplot()+
geom_boxplot(aes(x = fct_reorder(house, week_3, .desc = TRUE), y = week_3, fill = bloodStatus), notch = TRUE)+
scale_fill_manual(values = c("muggle-born" = "yellow", "pure-blood" = "turquoise2", "half-blood" = "pink"),
labels = c("muggle-born" = "Маглорожденные", "pure-blood" = "Чистокровные", "half-blood" = "полукровки"))+
labs(x = "Факультет", y = "Оценки за третью неделю", fill = "Происхождение") +
theme_custom
3. Добавьте на график джиттер-плот. Удалите отображение выбросов у
боксплота. Видоизмените по своему вкусу толщину линий и ширину
боксплота. (1 б.) Дополнительно: Добавьте название графика и подпись
(0.5 б.)
hogwarts |>
select(house, week_3, bloodStatus) |>
ggplot() +
geom_boxplot(aes(x = fct_reorder(house, week_3, .desc = TRUE), y = week_3, fill = bloodStatus),
notch = TRUE,
outlier.shape = NA,
size = 1.2,
width = 0.6
) +
geom_jitter(aes(x = fct_reorder(house, week_3, .desc = TRUE), y = week_3),
width = 0.15, height = 0, size = 2) +
scale_fill_manual(values = c("muggle-born" = "yellow", "pure-blood" = "turquoise2", "half-blood" = "pink"),
labels = c("muggle-born" = "Маглорожденные", "pure-blood" = "Чистокровные", "half-blood" = "Полукровки")) +
labs(
title = "Оценки студентов Хогвартса за третью неделю",
subtitle = "Распределение оценок по факультетам и происхождению студентов",
x = "Факультет",
y = "Оценки за третью неделю",
fill = "Происхождение",
color = "Происхождение"
) +
theme_classic() +
theme_custom
hogwarts |>
filter(course == "5") |>
mutate(id = as.factor(id)) |>
ggplot()+
geom_segment(aes(x = fct_reorder(id, result, .desc = TRUE), xend = id, y = 0, yend = result))+
geom_point(aes(x = id, y = result, color = wandCore))+
scale_color_manual(values = c("dragon heartstring" = "red", "phoenix feather" = "yellow2", "unicorn hair" = "gray50"),
labels = c("dragon heartstring" = "Жила дракона", "phoenix feather" = "Перо феникса", "unicorn hair" = "Волос единорога")) +
labs(
title = "Оценки пятикурсников Хогвартса за весь учебный год",
x = "Студент",
y = "Оценки за учебный год",
fill = "Материал палочки",
color = "Материал палочки"
) +
theme_classic()+
theme(
axis.title.x = element_text(size = 22),
axis.title.y = element_text(size = 22),
axis.text.x = element_text(size = 6),
axis.text.y = element_text(size = 20),
legend.title = element_text(size = 22),
legend.text = element_text(size = 20),
plot.title = element_text(size = 26),
)
2. Постройте гистограмму распредления баллов за экзамен по астрономии.
Выделите цветом факультет Слизерин. Примените 18-й кегль к тексту на
осях x, y и легенды. Название оси y и легенды запишите 20-м кеглем, оси
x – 22-м. Измените название оси y на “Number of students”. (1 б.)
ggplot()+
geom_histogram(data = hogwarts, aes(x = `Astronomy exam`, fill = house == "Slytherin"), color = "black", alpha=0.6)+
scale_fill_manual(values = c("FALSE" = "red", "TRUE" = "#1F5D25"),
labels = c("FALSE" = "Другие факультеты", "TRUE" = "Слизерин")) +
labs(
title = "Баллы за экзамен по астрономии",
y = "Number of students",
fill = "Факультет",
color = "Факультет"
) +
theme_classic()+
theme(
axis.title.x = element_text(size = 22),
axis.title.y = element_text(size = 20),
axis.text.x = element_text(size = 18),
axis.text.y = element_text(size = 18),
legend.title = element_text(size = 20),
legend.text = element_text(size = 18),
plot.title = element_text(size = 22),
)
3. На лекции мы использовали комбинацию theme_bw(), и созданной нами
theme_custom, чтобы одновременно сделать фон белым и увеличить шрифт.
Модифицируйте theme_custom таким образом, чтобы она и выполняла свои
прежние функции, и делала фон белым без помощи theme_bw(). Примените
новую кастомную тему к графику, полученному в последнем пункте блока по
боксплотам (1.5 б).
theme_custom <- theme(
axis.title.x = element_text(size = 22),
axis.title.y = element_text(size = 22),
axis.text.x = element_text(size = 18),
axis.text.y = element_text(size = 18),
legend.title = element_text(size = 22),
legend.text = element_text(size = 18),
plot.title = element_text(size = 26),
panel.background = element_rect(fill='white'),
panel.grid.major = element_line(color = 'gray30', size = 0.5),
panel.grid.minor = element_line(color = 'gray80', size = 0.25),
)
hogwarts |>
select(house, week_3, bloodStatus) |>
ggplot() +
geom_boxplot(aes(x = fct_reorder(house, week_3, .desc = TRUE), y = week_3, fill = bloodStatus),
notch = TRUE,
outlier.shape = NA,
size = 1.2,
width = 0.6
) +
geom_jitter(aes(x = fct_reorder(house, week_3, .desc = TRUE), y = week_3),
width = 0.15, height = 0, size = 2) +
scale_fill_manual(values = c("muggle-born" = "yellow", "pure-blood" = "turquoise2", "half-blood" = "pink"),
labels = c("muggle-born" = "Маглорожденные", "pure-blood" = "Чистокровные", "half-blood" = "Полукровки")) +
labs(
title = "Оценки студентов Хогвартса за третью неделю",
subtitle = "Распределение оценок по факультетам и происхождению студентов",
x = "Факультет",
y = "Оценки за третью неделю",
fill = "Происхождение",
color = "Происхождение"
) +
theme_custom
Гистограммы, на мой личный вкус, лучше фасетировать по столбцам, чтобы лучше видеть различия по ширине и форме распределений.
Кому-то может больше понравится фасетирование по строкам, чтобы все столбцы были один под другим и было удобнее сравнивать высоту одних и тех же столбиков. Но чисто визуально мне так не нравится.
Для вайолин плот фасетирование по столбцам выглядит лучше, так как удобнее сравнивать ширину виолончелей (количество значений для одинаковых y). Фасетирование по столбцам делает сравнение более естественным, поскольку виолончели располагаются горизонтально и их проще сопоставить по ширине и форме.
В целом мое мнение:
На мой взгяд, способ фасетирования для графиков зависит от количества категорий, а также фасетирование не должно искажать пропорции графика и стирать отличия между значениями.
Фасетирование по строкам лучше подходит, если категорий до 4-5, а фасетирование по столбцам более эффективно, если категорий больше.
Горизонтальные сравнения (когда смотрим слева направо) более естественны для человеческого восприятия.
Общее правило: Все правила визуализации должны быть гибкими в зависимости от типа данных и цели визуализации.
Оптимальная ширина столбца была выбрана по правилу Фридмана-Дьякониса, согласно его формуле ширина столбца = 2 * IQR/ n^(1/3) , где IQR - интерквартильный размах, а n - количество случаев
fd_binwidth <- function(x) {
IQR_x <- IQR(x)
n <- length(x)
binwidth <- 2 * IQR_x / n^(1/3)
return(binwidth)
}
optimal_binwidth <- fd_binwidth(hogwarts$`Care of magical creatures exam`)
ggplot(hogwarts)+
geom_histogram(aes(x = `Care of magical creatures exam`),
fill = "turquoise2",
colour = "grey49",
binwidth = optimal_binwidth
)+
theme_custom+
theme(strip.text = element_text(size = 15))
Фасетирование по курсу
Ширина столбца увеличена и подобрана вручную, так как в каждой гистограмме стало меньше наблюдений, и это число не равно для всех трех графиков
ggplot(hogwarts)+
geom_histogram(aes(x = `Care of magical creatures exam`),
fill = "turquoise2",
colour = "grey49",
binwidth = 10)+
facet_wrap(vars(course))+
theme_bw()+
theme_custom+
theme(strip.text = element_text(size = 15))
ggplot(hogwarts)+
geom_density(aes(x = `Herbology exam`,
fill = "Herbology",
colour = "Herbology"),
alpha = 0.5)+
geom_density(aes(x = `Defence against the dark arts exam`,
fill = "Defence against the dark arts",
colour = "Defence against the dark arts"),
alpha = 0.5)+
facet_wrap(vars(sex))+
scale_fill_manual(name = "Экзамен",
values = c("Herbology" = "turquoise1", "Defence against the dark arts" = "yellow")) +
scale_colour_manual(name = "Экзамен",
values = c("Herbology" = "grey49", "Defence against the dark arts" = "grey49")) +
theme_bw()+
theme_custom